home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SOURCES / ASM / SCANNUM.ASM < prev    next >
Encoding:
Assembly Source File  |  1992-11-18  |  11.5 KB  |  452 lines
  1. ;* SCANNUM.ASM
  2. ;************************************************************************
  3. ;*                                    *
  4. ;*        PC Scheme/Geneva 4.00 Borland TASM code            *
  5. ;*                                    *
  6. ;* (c) 1985-1988 by Texas Instruments, Inc. See COPYRIGHT.TXT        *
  7. ;* (c) 1992 by L. Bartholdi & M. Vuilleumier, University of Geneva    *
  8. ;*                                    *
  9. ;*----------------------------------------------------------------------*
  10. ;*                                    *
  11. ;*            Numeric I/O support                *
  12. ;*                                    *
  13. ;*----------------------------------------------------------------------*
  14. ;*                                    *
  15. ;* Created by: John Jensen        Date: 1985            *
  16. ;* Revision history:                            *
  17. ;* - 18 Jun 92:    Renaissance (Borland Compilers, ...)            *
  18. ;*                                    *
  19. ;*                    ``In nomine omnipotentii dei''    *
  20. ;************************************************************************
  21. IDEAL
  22. %PAGESIZE    60, 132
  23. MODEL    medium
  24. LOCALS    @@
  25.  
  26.     INCLUDE    "scheme.ash"
  27.  
  28. DATASEG
  29. decpoint DB    '.'
  30.  
  31. CODESEG
  32. ;************************************************************************
  33. ;*    Classify numeric string ending with a control character        *
  34. ;*    Calling sequence: scannum(s,base)                *
  35. ;*        Where ---- s:    pointer to start of character string    *
  36. ;*                base: default base            *
  37. ;* This function returns 0 if not a number, -1 if a flonum, and n>0    *
  38. ;* if an integer, where n is the number of digits in the integer.    *
  39. ;*                                    *
  40. ;* NOTE : ds is not guaranteed to point to the local data segment    *
  41. ;*                                    *
  42. ;************************************************************************
  43. PROC C    scannum    USES si, @@string:WORD, @@base:WORD
  44.     cld
  45.     mov    si, [@@string]
  46.     mov    bx, [@@base]
  47.     xor    cx, cx        ; Initialize digit count
  48. @@baseloop:
  49.     lodsb
  50.     cmp    al, '#'        ; skip over the base macros
  51.     jne    @@notmacro
  52.     lodsb            ; Get base argument
  53.     sub    al, 40h
  54.     js    @@notanumber    ; If not a base designator, not a number
  55.     and    al, not ('a' - 'A')
  56.     xor    bl, bl        ; bl will get incremented
  57.     cmp    al, 'E' - 40h
  58.     je    @@baseloop
  59.     cmp    al, 'I' - 40h
  60.     je    @@baseloop
  61.     cmp    al, 'L' - 40h
  62.     je    @@baseloop
  63.     cmp    al, 'S' - 40h
  64.     je    @@baseloop
  65.     cmp    al, 'B' - 40h
  66.     je    @@binary
  67.     cmp    al, 'D' - 40h
  68.     je    @@decimal
  69.     cmp    al, 'O' - 40h
  70.     je    @@octal
  71.     cmp    al, 'X' - 40h
  72.     je    @@hexadecimal
  73.     cmp    al, 'H' - 40h
  74.     jne    @@notanumber
  75. @@hexadecimal:
  76.     mov    bl, 6
  77. @@decimal:
  78.     add    bl, 2
  79. @@octal:
  80.     add    bl, 6
  81. @@binary:
  82.     add    bl, 2
  83.     jmp    @@baseloop        ; Check for another switch
  84. @@notmacro:
  85.     cmp    al, '+'
  86.     je    @@skipsign
  87.     cmp    al, '-'
  88.     jne    @@notsign
  89. @@skipsign:
  90.     lodsb
  91. @@notsign:
  92.     cmp    al, [ss:decpoint]
  93.     je    @@alreadyflonum
  94.     call    isdg
  95.     jnc    @@notanumber
  96. @@loop:
  97.     lodsb
  98.     call    isdg
  99.     jc    @@loop
  100.     cmp    al, ' '            ; done ?
  101.     jb    @@itsanumber
  102.     cmp    al, [ss:decpoint]
  103.     je    @@flonum
  104.     call    ismarker
  105.     je    @@exponent
  106. @@notanumber:
  107.     xor    ax, ax            ; Return 0, forget all else
  108.     ret
  109. @@itsanumber:
  110.     mov    ax, cx        ;Return digit count
  111.     ret
  112. @@alreadyflonum:
  113.     lodsb                ; We must have a digit here
  114.     call    isdg
  115.     jnc    @@notanumber
  116. @@flonum:
  117.     lodsb                ; Get characters up to non-digit
  118.     call    isdg
  119.     jc    @@flonum
  120.     cmp    al, ' '            ; If end of string, we have flonum
  121.     jb    @@retflonum
  122.     call    ismarker        ;Otherwise, check for exponent marker
  123.     je    @@exponent
  124.     jne    @@notanumber
  125. @@exponent:
  126.     mov    bl, 10            ; Exponents are in base 10
  127.     lodsb
  128.     cmp    al, '-'
  129.     jne    @@skipexpsign
  130.     lodsb
  131. @@skipexpsign:
  132.     call    isdg            ; We must end with a nonempty string
  133.     jnc    @@notanumber
  134. @@exploop:
  135.     lodsb
  136.     call    isdg
  137.     jc    @@exploop
  138.     cmp    al, ' '            ; If not end of string, it ain't no number
  139.     jae    @@notanumber
  140. @@retflonum:
  141.     mov    ax, -1            ; Return -1 (flonum code)
  142.     ret
  143. ENDP    scannum
  144.  
  145. ;************************************************************************
  146. ;* ISDG: CF is set iff the char in al is a digit in base bx        *
  147. ;*        Also, if a digit, the digit count in cx is incremented    *
  148. ;************************************************************************
  149. PROC    isdg    NEAR
  150.     cmp    al, '0'
  151.     jl    @@notadigit
  152.     cmp    al, '1'            ; 0 or 1 anytime
  153.     jbe    @@digit
  154.     cmp    bl, 2            ; Nothing else for base 2
  155.     je    @@notadigit
  156.     cmp    al, '7'            ; 2-7 for base 8, 10, 16
  157.     jbe    @@digit
  158.     cmp    bl, 8            ; Nothing else for base 8
  159.     je    @@notadigit
  160.     cmp    al, '9'            ; 8 or 9 for bases 10 or 16
  161.     jbe    @@digit
  162.     cmp    bl, 10            ; Nothing else for base 10
  163.     je    @@notadigit
  164.     and    al, not ('a' - 'A')
  165.     cmp    al, 'A'            ; base 16... check for A-F
  166.     jb    @@notadigit
  167.     cmp    al, 'F'
  168.     jbe    @@digit
  169. @@notadigit:
  170.     clc
  171.     ret
  172. @@digit:
  173.     inc    cx            ; Increment digit count
  174.     stc
  175.     ret
  176. ENDP    isdg
  177.  
  178. ;************************************************************************
  179. ;* ISMARKER: ZF is set iff the character in al is an exponent marker    *
  180. ;************************************************************************
  181. PROC    ismarker    NEAR
  182. IRP    EXP, <'e', 'E', 'l', 'L'>
  183.     cmp    al, EXP
  184.     je    @@mark
  185. ENDM
  186. @@mark:
  187.     ret
  188. ENDP    ismarker
  189.  
  190. ;************************************************************************
  191. ;*        Check character for digit status in a given base    *
  192. ;*    Calling sequence: isdig(c,base)                    *
  193. ;*        Where    c:     character to check            *
  194. ;*            base: base in which to check            *
  195. ;************************************************************************
  196. PROC C    isdig,    @@char:WORD, @@base:WORD
  197.     mov    al, [BYTE @@char]
  198.     mov    bx, [@@base]
  199.     call    isdg
  200.     jc    @@digit        ; Was a digit...don't zero ax
  201.     xor    ax, ax        ; Otherwise return 0
  202. @@digit:
  203.     ret
  204. ENDP    isdig
  205.  
  206. ;************************************************************************
  207. ;*        Convert digit character to its value            *
  208. ;*    Calling sequence: digval(c)                    *
  209. ;*        Where ---- c: assumed to be a digit character        *
  210. ;************************************************************************
  211. PROC C    digval,    @@char:WORD
  212.     mov    al, [BYTE @@char]
  213.     xor    ah, ah
  214.     and    al, 1fh        ; Reduce bits
  215.     cmp    al, 10h        ; Number or letter?
  216.     jb    @@hexdigit
  217.     and    al, 0fh        ; Zero the high nibble
  218.     ret
  219. @@hexdigit:
  220.     add    al, 9        ;Raise the lower nibble
  221.     ret
  222. ENDP    digval
  223.  
  224. ;************************************************************************
  225. ;*        Convert flonum in interval [1.0e15,1.0e16) to bignum    *
  226. ;*    Calling sequence: flo2big(flo,buf)                *
  227. ;* Where    flo: flonum in interval [1e15,1e16)            *
  228. ;*        buf: bignum math buffer, minimum size 11 bytes        *
  229. ;************************************************************************
  230. P8087
  231. PROC C    flo2big    USES si di, @@float:QWORD, @@big:WORD
  232.     LOCAL    @@status:WORD
  233.     mov    di, [@@big]
  234.     mov    [WORD di], 4    ; Store bignum size (words) in buffer
  235.     mov    [BYTE di+2], 0    ; assume positive
  236.     fld    [@@float]
  237.     ftst
  238.     fstsw    [@@status]
  239.     fabs
  240.     fistp    [QWORD di+3]
  241.     mov    ax, [@@status]
  242.     sahf
  243.     jae    @@positive
  244.     inc    [BYTE di+2]    ; sign is now 1
  245. @@positive:
  246.     ret
  247. ENDP    flo2big
  248.  
  249. ;************************************************************************
  250. ;* Form floating-point ASCII representation from 16 digits and scale    *
  251. ;*    Calling sequence: formflo(digs,chars,scale,prec,exp)        *
  252. ;* Where    digs:    the digit characters of the flonum        *
  253. ;*        chars:    buffer to store the formed flonum        *
  254. ;*        scale:    flonum exponent part                *
  255. ;*        prec:    desired precision                *
  256. ;*        exp:    whether to use exponential format        *
  257. ;* Returns the length of the formed flonum string            *
  258. ;************************************************************************
  259. PROC C    formflo USES si di, @@digs:WORD, @@chars:WORD, $$scale:WORD, @@prec:WORD, @@exp:WORD
  260.     push    ds
  261.     pop    es
  262.     mov    si, [@@digs]
  263.     mov    di, [@@chars]
  264.     cld
  265.     mov    dx, [@@exp]
  266.     mov    al, [si]        ; Fetch first digit
  267.     cmp    al, '0'
  268.     je    @@underflow
  269.     cmp    al, '-'
  270.     jne    @@notsigned
  271.     stosb                ; Put sign in return buffer
  272.     inc    [@@digs]        ; Adjust pointer to first digit
  273.     inc    si
  274. @@notsigned:
  275.     mov    bx, 14            ; Round off the last digit
  276.     call    round_asc
  277.     mov    bx, [@@prec]        ; Fetch precision
  278.     or    bx, bx
  279.     jz    @@putalldigits
  280.     cmp    bx, 14            ; If precision out of range, replace
  281.     jbe    @@validprecision
  282.     mov    bx, 14
  283. @@validprecision:
  284.     or    dx, dx
  285.     jnz    @@round            ; If exponential, round now
  286.     add    bx, [$$scale]        ; Add scale to precision
  287.     jns    @@notsmall        ; Jump unless number rounds to 0
  288.     cmp    bx, -1
  289.     jne    @@underflow        ; Jump if num definitely rounds to 0
  290.     cmp    [BYTE si], '5'
  291.     jb    @@underflow
  292.     mov    [WORD si], ' 1'        ; Else round up and adjust scale
  293.     inc    [$$scale]
  294.     jmp    @@doit
  295.  
  296. @@underflow:
  297.     mov    al, '0'            ; put (prec+1) 0's at start of input buf
  298.     mov    bx, [@@prec]
  299. @@underflowloop:
  300.     mov    [si], al
  301.     inc    si
  302.     dec    bl
  303.     jns    @@underflowloop
  304.     mov    [BYTE si], ' '        ; follow by space
  305.     mov    di, [@@chars]        ; Start output over (wipe out any sign)
  306.     jmp    @@doit
  307.  
  308. @@notsmall:
  309.     cmp    bx, 16            ; then, no need to round
  310.     jae    @@doit
  311. @@round:
  312.     call    round_asc
  313.     jmp    @@doit
  314.  
  315. @@putalldigits:                ; For arbitrary precision, change all
  316.     ; trailing zeros to spaces (there exists at least one nonzero digit)
  317.     add    si, 14        ;Point si to last digit
  318. @@spaceloop:
  319.     cmp    [BYTE si], '0'
  320.     jne    @@doit
  321.     mov    [BYTE si], ' '
  322.     dec    si
  323.     jmp    @@spaceloop
  324. @@doit:                    ; Now the spaces are in - start formatting
  325.     mov    si, [@@digs]        ; Point si to digit string
  326.     mov    bx, [$$scale]
  327.     mov    cx, [@@prec]
  328.     or    dx, dx            ; exponent form desired ?
  329.     jnz    @@exponentform
  330.     cmp    bx, -14            ; If scale>-15, check precision
  331.     jge    @@midscale
  332.     or    cl, cl            ; If arbitrary, force expo-form
  333.     jz    @@exponentform
  334. @@midscale:
  335.     or    bx, bx
  336.     jl    @@smallfix
  337.     cmp    bx, 14
  338.     jle    @@largefix
  339. @@exponentform:
  340.     movsb                ; Transfer first digit
  341.     mov    al, [decpoint]
  342. @@putexponent:
  343.     stosb                ; Store character
  344.     lodsb                ; Transfer digits up to first space
  345.     cmp    al, ' '
  346.     jne    @@putexponent
  347.     mov    al, 'e'            ; place exponent marker
  348.     stosb
  349.     or    bx, bx            ;If scale negative, negate & store sign
  350.     jge    @@positivescale
  351.     neg    bx
  352.     mov    al, '-'
  353.     stosb
  354. @@positivescale:
  355.     mov    ax, bx
  356.     mov    bh, 10
  357.     mov    dx, sp            ; Save current stack pointer
  358. @@divideexponent:
  359.     div    bh            ; Divide
  360.     mov    bl, ah            ; Push digit
  361.     add    bl, '0'
  362.     push    bx
  363.     and    ax, 0ffh        ; Remove the remainder
  364.     jnz    @@divideexponent
  365. @@storeexponent:
  366.     pop    ax            ; Restore exponent digit
  367.     stosb
  368.     cmp    sp, dx            ; Loop until no more digits left
  369.     jne    @@storeexponent
  370.     jmp    @@ret
  371.  
  372. ;Form a fixed-decimal flonum magnitude greater than 1
  373. @@largefix:
  374.     lodsb
  375.     or    al, 10h            ; Turn ' ' to '0'
  376.     stosb
  377.     dec    bl            ; Loop until all pre-point digs done
  378.     jns    @@largefix
  379.     mov    al, [decpoint]
  380.     stosb
  381. @@mergedigits:
  382.     or    cl, cl
  383.     jnz    @@precisionloop
  384. @@arbitraryloop:
  385.     lodsb                ; Otherwise, arbitrary; do until space
  386.     cmp    al, ' '
  387.     je    @@ret
  388.     stosb
  389.     jmp    @@arbitraryloop
  390. @@largeloop:
  391.     stosb
  392. @@precisionloop:
  393.     dec    cl            ; Last digit done?
  394.     js    @@ret
  395.  
  396.     lodsb                ; Now do digits until precision reached
  397.     cmp    al, ' '
  398.     jne    @@largeloop
  399.     dec    si            ; Restore si
  400.     mov    al, '0'            ; prepare to place 0
  401.     jmp    @@largeloop
  402.  
  403. ;Form a fixed-decimal flonum magnitude less than 1
  404. @@smallfix:
  405.     mov    ch, cl            ; Copy precision to ch
  406.     mov    al, '0'            ; place "0."
  407.     stosb
  408.     mov    al, [decpoint]
  409. @@shortloop:
  410.     stosb
  411.     inc    bx
  412.     jz    @@mergedigits        ; If 0's done, do significant figures
  413.     or    ch, ch            ; If precision was zero
  414.     jz    @@skipprec
  415.     dec    cl
  416.     js    @@ret
  417. @@skipprec:
  418.     mov    al, '0'            ; otherwise, place 0's until scale=0
  419.     jmp    @@shortloop
  420.  
  421. @@ret:
  422.     mov    ax, di            ; Return length of string
  423.     sub    ax, [@@chars]
  424.     ret
  425. ENDP    formflo
  426.  
  427. ;************************************************************************
  428. ;* ROUND: Round the ASCII digits of a flonum, starting at [bx+si]    *
  429. ;*        si->start of digits and is unchanged; bx destroyed    *
  430. ;************************************************************************
  431. PROC    round_asc    NEAR
  432.     mov    al, ' '            ; get digit after least-rounded and
  433.     xchg    al, [bx+si+1]        ; replace it with a space
  434.     cmp    al, '5'
  435.     jb    @@rounded
  436. @@loop:
  437.     mov    al, [bx+si]        ; Otherwise, increment digit
  438.     inc    al
  439.     mov    [bx+si], al        ; Replace incremented digit
  440.     cmp    al, '9'
  441.     jbe    @@rounded
  442.     mov    [BYTE bx+si], '0'
  443.     dec    bx            ; Go to next digit
  444.     jns    @@loop
  445.     mov    [BYTE bx+si+1], '1'    ; there are no more digits, place
  446.     inc    [$$scale]        ; a leading 1 and adjust scale
  447. @@rounded:
  448.     ret
  449. ENDP    round_asc
  450.  
  451.     END
  452.